indiv smooths
Megan Lott
10/14/2020
Load all required libraries.
library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.3 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.0 v forcats 0.5.1## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutlibrary(broom)Read in raw data from RDS.
raw_data <- readRDS("./n1_n2_cleaned_cases.rds")Make a few small modifications to names and data for visualizations.
final_data <- raw_data %>% mutate(log_copy_per_L = log10(mean_copy_num_L)) %>%
rename(Facility = wrf) %>%
mutate(Facility = recode(Facility,
"NO" = "WRF A",
"MI" = "WRF B",
"CC" = "WRF C"))Seperate the data by gene target to ease layering in the final plot
#make three data layers
only_positives <<- subset(final_data, (!is.na(final_data$Facility)))
only_n1 <- subset(only_positives, target == "N1")
only_n2 <- subset(only_positives, target == "N2")
only_background <<-final_data %>%
select(c(date, cases_cum_clarke, new_cases_clarke, X7_day_ave_clarke)) %>%
group_by(date) %>% summarise_if(is.numeric, mean)
#specify fun colors
background_color <- "#7570B3"
seven_day_ave_color <- "#E6AB02"
marker_colors <- c("N1" = '#1B9E77',"N2" ='#D95F02')#remove facilty C for now
#only_n1 <- only_n1[!(only_n1$Facility == "WRF C"),]
#only_n2 <- only_n2[!(only_n2$Facility == "WRF C"),]
only_n1 <- only_n1[!(only_n1$Facility == "WRF A" & only_n1$date == "2020-11-02"), ]
only_n2 <- only_n2[!(only_n2$Facility == "WRF A" & only_n2$date == "2020-11-02"), ]Build the main plot
#first layer is the background epidemic curve
p1 <- only_background %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~new_cases_clarke,
type = "bar",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Daily Cases: ', new_cases_clarke),
alpha = 0.5,
name = "Daily Reported Cases",
color = background_color,
colors = background_color,
showlegend = FALSE) %>%
layout(yaxis = list(title = "Clarke County Daily Cases", showline=TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#renders the main plot layer two as seven day moving average
p1 <- p1 %>% plotly::add_trace(x = ~date, y = ~X7_day_ave_clarke,
type = "scatter",
mode = "lines",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Seven-Day Moving Average: ', X7_day_ave_clarke),
name = "Seven Day Moving Average Athens",
line = list(color = seven_day_ave_color),
showlegend = FALSE)
#renders the main plot layer three as positive target hits
p2 <- plotly::plot_ly() %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n1,
symbol = ~Facility,
marker = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
plotly::add_trace(x = ~date, y = ~mean_copy_num_L,
type = "scatter",
mode = "markers",
hoverinfo = "text",
text = ~paste('</br> Date: ', date,
'</br> Facility: ', Facility,
'</br> Target: ', target,
'</br> Copies/L: ', round(mean_copy_num_L, digits = 2)),
data = only_n2,
symbol = ~Facility,
marker = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(yaxis = list(title = "SARS CoV-2 Copies/L",
showline = TRUE,
type = "log",
dtick = 1,
automargin = TRUE)) %>%
layout(legend = list(orientation = "h", x = 0.2, y = -0.3))
#adds the limit of detection dashed line
p2 <- p2 %>% plotly::add_segments(x = as.Date("2020-03-14"),
xend = ~max(date + 10),
y = 3571.429, yend = 3571.429,
opacity = 0.35,
line = list(color = "black", dash = "dash")) %>%
layout(annotations = list(x = as.Date("2020-03-28"), y = 3.8, xref = "x", yref = "y",
text = "Limit of Detection", showarrow = FALSE))
p1 p2Combine the two main plot pieces as a subplot
#seperate n1 and n2 frames by site
#n1
wrf_a_only_n1 <- subset(only_n1, Facility == "WRF A")
wrf_b_only_n1 <- subset(only_n1, Facility == "WRF B")
wrf_c_only_n1 <- subset(only_n1, Facility == "WRF C")
#n2
wrf_a_only_n2 <- subset(only_n2, Facility == "WRF A")
wrf_b_only_n2 <- subset(only_n2, Facility == "WRF B")
wrf_c_only_n2 <- subset(only_n2, Facility == "WRF C")
#rejoin the old data frames then seperate in to averages for each plant.
wrfa_both <- full_join(wrf_a_only_n1, wrf_a_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfb_both <- full_join(wrf_b_only_n1, wrf_b_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")wrfc_both <- full_join(wrf_c_only_n1, wrf_c_only_n2)%>%
select(c(date, mean_total_copies)) %>%
group_by(date) %>%
summarize_if(is.numeric, mean) %>%
ungroup() %>%
mutate(log_total_copies_both = log10(mean_total_copies))## Joining, by = c("date", "new_cases_clarke", "cases_cum_clarke", "X7_day_ave_clarke", "Facility", "collection_num", "target", "mean_copy_num_uL_rxn", "mean_copy_num_L", "sd_L", "mean_total_copies", "sd_total_copies", "day", "log_copy_per_L")#get max date
maxdate <- max(wrfa_both$date)
mindate <- min(wrfa_both$date)Build loess smoothing figures figures
This makes the individual plots
#**************************************WRF A PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_botha <- ggplot(wrfa_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_botha<<-..y..), method = "loess", color = '#1B9E77',
span = 0.6, n = 415)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_botha## `geom_smooth()` using formula 'y ~ x'
fit_botha## [1] 13.01275 13.00936 13.00601 13.00269 12.99940 12.99614 12.99292 12.98973
## [9] 12.98657 12.98346 12.98037 12.97732 12.97431 12.97134 12.96840 12.96550
## [17] 12.96264 12.95981 12.95703 12.95429 12.95158 12.94892 12.94630 12.94372
## [25] 12.94118 12.93869 12.93624 12.93383 12.93147 12.92915 12.92687 12.92464
## [33] 12.92246 12.92032 12.91824 12.91619 12.91420 12.91226 12.91036 12.90851
## [41] 12.90672 12.90497 12.90327 12.90164 12.90007 12.89858 12.89715 12.89578
## [49] 12.89448 12.89324 12.89206 12.89094 12.88988 12.88888 12.88793 12.88703
## [57] 12.88619 12.88540 12.88466 12.88397 12.88333 12.88273 12.88218 12.88167
## [65] 12.88120 12.88077 12.88038 12.88003 12.87972 12.87944 12.87919 12.87898
## [73] 12.87879 12.87864 12.87851 12.87842 12.87834 12.87829 12.87827 12.87826
## [81] 12.87828 12.87831 12.87836 12.87843 12.87851 12.87865 12.87890 12.87925
## [89] 12.87969 12.88023 12.88086 12.88158 12.88238 12.88326 12.88421 12.88523
## [97] 12.88632 12.88748 12.88870 12.88997 12.89129 12.89267 12.89409 12.89554
## [105] 12.89704 12.89857 12.90013 12.90172 12.90333 12.90496 12.90660 12.90826
## [113] 12.90992 12.91158 12.91325 12.91491 12.91656 12.91821 12.91983 12.92144
## [121] 12.92303 12.92459 12.92612 12.92761 12.92907 12.93048 12.93185 12.93317
## [129] 12.93493 12.93757 12.94098 12.94508 12.94978 12.95499 12.96061 12.96657
## [137] 12.97276 12.97909 12.98549 12.99184 12.99808 13.00409 13.00980 13.01512
## [145] 13.01994 13.02419 13.02777 13.03060 13.03257 13.03507 13.03942 13.04542
## [153] 13.05286 13.06155 13.07129 13.08189 13.09314 13.10484 13.11681 13.12884
## [161] 13.14073 13.15228 13.16330 13.17359 13.18295 13.19118 13.19808 13.20347
## [169] 13.20713 13.20886 13.20960 13.21035 13.21111 13.21187 13.21259 13.21328
## [177] 13.21391 13.21447 13.21494 13.21530 13.21554 13.21564 13.21558 13.21535
## [185] 13.21494 13.21432 13.21348 13.21241 13.21108 13.20948 13.20760 13.20542
## [193] 13.20292 13.20009 13.19690 13.19335 13.18941 13.18508 13.18033 13.17515
## [201] 13.16952 13.16343 13.15686 13.14979 13.14157 13.13167 13.12024 13.10746
## [209] 13.09347 13.07844 13.06253 13.04590 13.02871 13.01113 12.99330 12.97540
## [217] 12.95758 12.94001 12.92284 12.90623 12.89035 12.87535 12.86140 12.84866
## [225] 12.83537 12.81983 12.80225 12.78285 12.76187 12.73951 12.71599 12.69155
## [233] 12.66640 12.64076 12.61485 12.58889 12.56310 12.53771 12.51294 12.48900
## [241] 12.46612 12.44451 12.42441 12.40602 12.38958 12.37390 12.35772 12.34109
## [249] 12.32408 12.30674 12.28913 12.27132 12.25337 12.23533 12.21728 12.19926
## [257] 12.18134 12.16359 12.14605 12.12880 12.11189 12.09538 12.07934 12.06382
## [265] 12.04889 12.03461 12.02113 12.00851 11.99668 11.98557 11.97511 11.96521
## [273] 11.95581 11.94684 11.93821 11.92986 11.92171 11.91369 11.90573 11.89775
## [281] 11.88967 11.88143 11.87295 11.86416 11.85498 11.84534 11.83516 11.82478
## [289] 11.81456 11.80451 11.79463 11.78492 11.77539 11.76603 11.75686 11.74786
## [297] 11.73905 11.73043 11.72199 11.71375 11.70570 11.69785 11.69019 11.68274
## [305] 11.67549 11.66844 11.66161 11.65498 11.64784 11.63956 11.63031 11.62022
## [313] 11.60947 11.59821 11.58658 11.57476 11.56288 11.55112 11.53962 11.52854
## [321] 11.51803 11.50826 11.49937 11.49152 11.48488 11.47958 11.47579 11.47367
## [329] 11.47337 11.47400 11.47458 11.47517 11.47581 11.47655 11.47743 11.47849
## [337] 11.47979 11.48135 11.48324 11.48550 11.48817 11.49129 11.49491 11.49908
## [345] 11.50384 11.50923 11.51531 11.52211 11.52968 11.53807 11.54696 11.55604
## [353] 11.56531 11.57481 11.58456 11.59458 11.60490 11.61553 11.62652 11.63787
## [361] 11.64961 11.66177 11.67436 11.68742 11.70096 11.71502 11.72961 11.74475
## [369] 11.76048 11.77681 11.79377 11.81138 11.82951 11.84800 11.86688 11.88614
## [377] 11.90579 11.92585 11.94632 11.96720 11.98851 12.01026 12.03245 12.05508
## [385] 12.07818 12.10174 12.12578 12.15030 12.17531 12.20082 12.22683 12.25336
## [393] 12.28041 12.30800 12.33617 12.36498 12.39442 12.42447 12.45511 12.48632
## [401] 12.51811 12.55044 12.58330 12.61668 12.65057 12.68495 12.71980 12.75511
## [409] 12.79086 12.82705 12.86364 12.90064 12.93802 12.97577 13.01388#assign fits to a vector
both_trenda <- fit_botha
#extract y min and max for each
limits_botha <- ggplot_build(extract_botha)$data## `geom_smooth()` using formula 'y ~ x'limits_botha <- as.data.frame(limits_botha)
both_ymina <- limits_botha$ymin
both_ymaxa <- limits_botha$ymax
#reassign dataframes (just to be safe)
work_botha <- wrfa_both
#fill in missing dates to smooth fits
work_botha <- work_botha %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_botha <- work_botha$date
#create a new smooth dataframe to layer
smooth_frame_botha <- data.frame(date_vec_botha, both_trenda, both_ymina, both_ymaxa)#WRF A
#plot smooth frames
p_wrf_a <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_botha, y = ~both_trenda,
data = smooth_frame_botha,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha,
'</br> Median Log Copies: ', round(both_trenda, digits = 2)),
line = list(color = '#1B9E77', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_botha, ymin = ~both_ymina, ymax = ~both_ymaxa,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_botha, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxa, digits = 2),
'</br> Min Log Copies: ', round(both_ymina, digits = 2)),
name = "",
fillcolor = '#1B9E77',
line = list(color = '#1B9E77')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF A") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_ymina), yend = ~max(both_ymaxa),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfa_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#1B9E77', size = 6, opacity = 0.65))
p_wrf_asave(p_wrf_a, file = "./plotly_objs/p_wrf_a.rda")#**************************************WRF B PLOT**********************************************
#add trendlines
#extract data from geom_smooth
#both extract
# *********************************span 0.6***********************************
#*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothb <- ggplot(wrfb_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothb<<-..y..), method = "loess", color = '#D95F02',
span = 0.6, n = 415)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothb## `geom_smooth()` using formula 'y ~ x'
fit_bothb## [1] 12.52977 12.52884 12.52794 12.52707 12.52623 12.52543 12.52466 12.52392
## [9] 12.52322 12.52256 12.52193 12.52134 12.52080 12.52030 12.51984 12.51942
## [17] 12.51905 12.51872 12.51844 12.51821 12.51803 12.51790 12.51783 12.51780
## [25] 12.51783 12.51792 12.51806 12.51826 12.51852 12.51883 12.51921 12.51965
## [33] 12.52016 12.52073 12.52136 12.52206 12.52283 12.52367 12.52458 12.52556
## [41] 12.52661 12.52773 12.52893 12.53021 12.53158 12.53303 12.53455 12.53616
## [49] 12.53784 12.53960 12.54143 12.54333 12.54530 12.54733 12.54943 12.55159
## [57] 12.55381 12.55609 12.55843 12.56082 12.56326 12.56575 12.56828 12.57087
## [65] 12.57349 12.57616 12.57887 12.58161 12.58440 12.58721 12.59006 12.59293
## [73] 12.59583 12.59876 12.60171 12.60468 12.60767 12.61068 12.61370 12.61674
## [81] 12.61978 12.62284 12.62590 12.62896 12.63203 12.63523 12.63867 12.64234
## [89] 12.64623 12.65033 12.65463 12.65911 12.66377 12.66860 12.67358 12.67870
## [97] 12.68396 12.68933 12.69481 12.70039 12.70605 12.71179 12.71760 12.72345
## [105] 12.72935 12.73528 12.74122 12.74718 12.75313 12.75906 12.76497 12.77084
## [113] 12.77666 12.78242 12.78811 12.79372 12.79924 12.80465 12.80994 12.81511
## [121] 12.82014 12.82501 12.82973 12.83428 12.83864 12.84280 12.84730 12.85259
## [129] 12.85859 12.86521 12.87235 12.87995 12.88789 12.89610 12.90449 12.91297
## [137] 12.92144 12.92983 12.93804 12.94599 12.95358 12.96073 12.96735 12.97335
## [145] 12.97864 12.98313 12.98674 12.99060 12.99581 13.00221 13.00965 13.01799
## [153] 13.02707 13.03674 13.04685 13.05725 13.06778 13.07830 13.08866 13.09870
## [161] 13.10827 13.11722 13.12540 13.13266 13.13884 13.14381 13.14739 13.14946
## [169] 13.15081 13.15237 13.15409 13.15594 13.15790 13.15994 13.16202 13.16411
## [177] 13.16618 13.16821 13.17015 13.17199 13.17369 13.17522 13.17654 13.17764
## [185] 13.17847 13.17901 13.17922 13.17908 13.17856 13.17762 13.17623 13.17436
## [193] 13.17199 13.16908 13.16560 13.16153 13.15682 13.15145 13.14451 13.13527
## [201] 13.12393 13.11072 13.09585 13.07955 13.06202 13.04348 13.02416 13.00427
## [209] 12.98402 12.96364 12.94334 12.92334 12.90385 12.88510 12.86730 12.85066
## [217] 12.83541 12.82177 12.80994 12.79787 12.78350 12.76707 12.74880 12.72894
## [225] 12.70770 12.68534 12.66207 12.63812 12.61374 12.58916 12.56460 12.54031
## [233] 12.51650 12.49342 12.47130 12.45037 12.43086 12.41301 12.39704 12.38320
## [241] 12.37059 12.35820 12.34600 12.33399 12.32216 12.31050 12.29900 12.28765
## [249] 12.27644 12.26535 12.25440 12.24355 12.23280 12.22215 12.21159 12.20109
## [257] 12.19066 12.18029 12.16996 12.15966 12.14940 12.13915 12.12890 12.11866
## [265] 12.10840 12.09812 12.08848 12.08005 12.07273 12.06639 12.06092 12.05621
## [273] 12.05214 12.04859 12.04544 12.04259 12.03991 12.03729 12.03462 12.03177
## [281] 12.02864 12.02510 12.02104 12.01634 12.01090 12.00458 11.99729 11.98965
## [289] 11.98237 11.97544 11.96880 11.96245 11.95634 11.95045 11.94476 11.93923
## [297] 11.93383 11.92855 11.92334 11.91818 11.91304 11.90790 11.90272 11.89747
## [305] 11.89214 11.88668 11.88108 11.87530 11.86853 11.86011 11.85024 11.83913
## [313] 11.82698 11.81399 11.80036 11.78630 11.77200 11.75767 11.74352 11.72973
## [321] 11.71652 11.70409 11.69264 11.68237 11.67348 11.66618 11.66066 11.65714
## [329] 11.65581 11.65548 11.65488 11.65407 11.65312 11.65210 11.65106 11.65007
## [337] 11.64919 11.64850 11.64805 11.64791 11.64814 11.64881 11.64999 11.65173
## [345] 11.65411 11.65718 11.66101 11.66567 11.67122 11.67773 11.68476 11.69186
## [353] 11.69906 11.70639 11.71389 11.72158 11.72949 11.73765 11.74611 11.75487
## [361] 11.76399 11.77348 11.78339 11.79373 11.80454 11.81586 11.82770 11.84011
## [369] 11.85312 11.86674 11.88103 11.89600 11.91148 11.92728 11.94341 11.95988
## [377] 11.97671 11.99390 12.01145 12.02939 12.04772 12.06645 12.08559 12.10515
## [385] 12.12515 12.14558 12.16647 12.18782 12.20964 12.23194 12.25473 12.27802
## [393] 12.30183 12.32616 12.35108 12.37667 12.40290 12.42975 12.45721 12.48525
## [401] 12.51385 12.54301 12.57268 12.60287 12.63355 12.66470 12.69630 12.72833
## [409] 12.76078 12.79362 12.82684 12.86041 12.89433 12.92856 12.96309#assign fits to a vector
both_trendb <- fit_bothb
#extract y min and max for each
limits_bothb <- ggplot_build(extract_bothb)$data## `geom_smooth()` using formula 'y ~ x'limits_bothb <- as.data.frame(limits_bothb)
both_yminb <- limits_bothb$ymin
both_ymaxb <- limits_bothb$ymax
#reassign dataframes (just to be safe)
work_bothb <- wrfb_both
#fill in missing dates to smooth fits
work_bothb <- work_bothb %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothb <- work_bothb$date
#create a new smooth dataframe to layer
smooth_frame_bothb <- data.frame(date_vec_bothb, both_trendb, both_yminb, both_ymaxb)#WRF B
#plot smooth frames
p_wrf_b <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothb, y = ~both_trendb,
data = smooth_frame_bothb,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb,
'</br> Median Log Copies: ', round(both_trendb, digits = 2)),
line = list(color = '#D95F02', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothb, ymin = ~both_yminb, ymax = ~both_ymaxb,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothb, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxb, digits = 2),
'</br> Min Log Copies: ', round(both_yminb, digits = 2)),
name = "",
fillcolor = '#D95F02',
line = list(color = '#D95F02')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF B") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminb), yend = ~max(both_ymaxb),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfb_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#D95F02', size = 6, opacity = 0.65))
p_wrf_bsave(p_wrf_b, file = "./plotly_objs/p_wrf_b.rda")#**************************************WRF C PLOT********************************************** #add trendlines #extract data from geom_smooth # *********************************span 0.6*********************************** #*****************Must always update the n = TOTAL NUMBER OF DAYS*************************
extract_bothc <- ggplot(wrfc_both, aes(x = date, y = log_total_copies_both)) +
stat_smooth(aes(outfit=fit_bothc<<-..y..), method = "loess", color = '#E7298A',
span = 0.6, n = 415)## Warning: Ignoring unknown aesthetics: outfit#look at the fits to align dates and total observations
#both
extract_bothc## `geom_smooth()` using formula 'y ~ x'
fit_bothc## [1] 11.99091 11.98628 11.98171 11.97722 11.97279 11.96844 11.96415 11.95994
## [9] 11.95580 11.95173 11.94774 11.94382 11.93997 11.93620 11.93251 11.92889
## [17] 11.92534 11.92187 11.91848 11.91517 11.91193 11.90878 11.90570 11.90270
## [25] 11.89979 11.89695 11.89419 11.89152 11.88893 11.88642 11.88399 11.88165
## [33] 11.87939 11.87722 11.87513 11.87313 11.87121 11.86938 11.86764 11.86598
## [41] 11.86441 11.86294 11.86155 11.86025 11.85904 11.85792 11.85689 11.85595
## [49] 11.85511 11.85436 11.85373 11.85324 11.85290 11.85270 11.85264 11.85271
## [57] 11.85291 11.85323 11.85368 11.85424 11.85492 11.85571 11.85661 11.85761
## [65] 11.85871 11.85991 11.86120 11.86259 11.86405 11.86560 11.86723 11.86893
## [73] 11.87070 11.87254 11.87445 11.87641 11.87843 11.88051 11.88263 11.88480
## [81] 11.88701 11.88926 11.89155 11.89386 11.89621 11.89858 11.90096 11.90337
## [89] 11.90579 11.90822 11.91065 11.91309 11.91558 11.91818 11.92088 11.92369
## [97] 11.92660 11.92961 11.93271 11.93591 11.93920 11.94257 11.94604 11.94958
## [105] 11.95321 11.95692 11.96070 11.96455 11.96848 11.97248 11.97654 11.98066
## [113] 11.98485 11.98910 11.99340 11.99775 12.00216 12.00662 12.01112 12.01567
## [121] 12.02025 12.02488 12.02954 12.03424 12.03897 12.04373 12.04851 12.05332
## [129] 12.05894 12.06606 12.07452 12.08419 12.09492 12.10655 12.11893 12.13193
## [137] 12.14539 12.15917 12.17311 12.18707 12.20091 12.21446 12.22759 12.24015
## [145] 12.25198 12.26295 12.27290 12.28169 12.28916 12.29748 12.30869 12.32250
## [153] 12.33858 12.35665 12.37638 12.39747 12.41961 12.44250 12.46582 12.48928
## [161] 12.51256 12.53535 12.55736 12.57826 12.59776 12.61554 12.63130 12.64473
## [169] 12.65553 12.66338 12.66963 12.67582 12.68192 12.68793 12.69382 12.69958
## [177] 12.70518 12.71061 12.71584 12.72087 12.72566 12.73022 12.73450 12.73851
## [185] 12.74221 12.74559 12.74863 12.75131 12.75362 12.75554 12.75704 12.75811
## [193] 12.75874 12.75889 12.75856 12.75773 12.75637 12.75447 12.75201 12.74898
## [201] 12.74534 12.74110 12.73621 12.73068 12.72327 12.71296 12.70004 12.68480
## [209] 12.66752 12.64849 12.62800 12.60635 12.58380 12.56066 12.53722 12.51375
## [217] 12.49054 12.46790 12.44609 12.42542 12.40616 12.38861 12.37305 12.35978
## [225] 12.34668 12.33160 12.31474 12.29629 12.27644 12.25539 12.23334 12.21048
## [233] 12.18701 12.16313 12.13902 12.11488 12.09092 12.06732 12.04429 12.02201
## [241] 12.00068 11.98050 11.96167 11.94437 11.92882 11.91405 11.89904 11.88382
## [249] 11.86841 11.85286 11.83718 11.82142 11.80561 11.78977 11.77395 11.75817
## [257] 11.74247 11.72688 11.71143 11.69616 11.68109 11.66627 11.65171 11.63746
## [265] 11.62355 11.61001 11.59678 11.58381 11.57108 11.55859 11.54633 11.53429
## [273] 11.52247 11.51086 11.49945 11.48825 11.47724 11.46641 11.45576 11.44529
## [281] 11.43499 11.42484 11.41485 11.40501 11.39532 11.38576 11.37633 11.36720
## [289] 11.35853 11.35029 11.34247 11.33503 11.32797 11.32124 11.31483 11.30871
## [297] 11.30287 11.29727 11.29189 11.28671 11.28171 11.27686 11.27214 11.26753
## [305] 11.26299 11.25851 11.25407 11.24964 11.24481 11.23926 11.23310 11.22643
## [313] 11.21937 11.21202 11.20450 11.19690 11.18933 11.18191 11.17473 11.16792
## [321] 11.16157 11.15580 11.15070 11.14640 11.14299 11.14058 11.13929 11.13921
## [329] 11.14047 11.14238 11.14423 11.14607 11.14793 11.14986 11.15189 11.15408
## [337] 11.15645 11.15906 11.16194 11.16513 11.16868 11.17263 11.17701 11.18187
## [345] 11.18725 11.19319 11.19974 11.20692 11.21479 11.22339 11.23243 11.24161
## [353] 11.25096 11.26049 11.27022 11.28019 11.29041 11.30091 11.31170 11.32281
## [361] 11.33426 11.34607 11.35827 11.37088 11.38391 11.39739 11.41135 11.42581
## [369] 11.44078 11.45629 11.47236 11.48901 11.50613 11.52358 11.54137 11.55949
## [377] 11.57797 11.59680 11.61599 11.63555 11.65548 11.67579 11.69648 11.71757
## [385] 11.73905 11.76093 11.78323 11.80594 11.82907 11.85262 11.87661 11.90104
## [393] 11.92592 11.95124 11.97706 12.00342 12.03030 12.05768 12.08557 12.11394
## [401] 12.14279 12.17210 12.20187 12.23207 12.26270 12.29376 12.32521 12.35706
## [409] 12.38930 12.42190 12.45487 12.48818 12.52183 12.55580 12.59009#assign fits to a vector
both_trendc <- fit_bothc
#extract y min and max for each
limits_bothc <- ggplot_build(extract_bothc)$data## `geom_smooth()` using formula 'y ~ x'limits_bothc <- as.data.frame(limits_bothc)
both_yminc <- limits_bothc$ymin
both_ymaxc <- limits_bothc$ymax
#reassign dataframes (just to be safe)
work_bothc <- wrfc_both
#fill in missing dates to smooth fits
work_bothc <- work_bothc %>% complete(date = seq(min(date), max(date), by = "1 day"))
date_vec_bothc <- work_bothc$date
#create a new smooth dataframe to layer
smooth_frame_bothc <- data.frame(date_vec_bothc, both_trendc, both_yminc, both_ymaxc)#WRF C
#plot smooth frames
p_wrf_c <- plotly::plot_ly() %>%
plotly::add_lines(x = ~date_vec_bothc, y = ~both_trendc,
data = smooth_frame_bothc,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc,
'</br> Median Log Copies: ', round(both_trendc, digits = 2)),
line = list(color = '#E7298A', size = 8, opacity = 0.65),
showlegend = FALSE) %>%
layout(xaxis = list(range = c(mindate - 7, maxdate + 7))) %>% #buffer here
plotly::add_ribbons(x ~date_vec_bothc, ymin = ~both_yminc, ymax = ~both_ymaxc,
showlegend = FALSE,
opacity = 0.25,
hoverinfo = "text",
text = ~paste('</br> Date: ', date_vec_bothc, #leaving in case we want to change
'</br> Max Log Copies: ', round(both_ymaxc, digits = 2),
'</br> Min Log Copies: ', round(both_yminc, digits = 2)),
name = "",
fillcolor = '#E7298A',
line = list(color = '#E7298A')) %>%
layout(yaxis = list(title = "Total Log SARS CoV-2 Copies",
showline = TRUE,
automargin = TRUE)) %>%
layout(xaxis = list(title = "Date")) %>%
layout(title = "WRF C") %>%
plotly::add_segments(x = as.Date("2020-06-24"),
xend = as.Date("2020-06-24"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Bars Repoen",
hoverinfo = "text",
text = "</br> Bars Reopen",
"</br> 2020-06-24",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-07-09"),
xend = as.Date("2020-07-09"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "Mask Mandate",
hoverinfo = "text",
text = "</br> Mask Mandate",
"</br> 2020-07-09",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-08-20"),
xend = as.Date("2020-08-20"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> Classes Begin",
"</br> 2020-08-20",
hoverinfo = "text",
text = "Classes Begin",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_segments(x = as.Date("2020-10-03"),
xend = as.Date("2020-10-03"),
y = ~min(both_yminc), yend = ~max(both_ymaxc),
opacity = 0.35,
name = "</br> First Home Football Game",
"</br> 2020-10-03",
hoverinfo = "text",
text = "First Home Football Game",
showlegend = FALSE,
line = list(color = "black", dash = "dash")) %>%
plotly::add_markers(x = ~date, y = ~log_total_copies_both,
data = wrfc_both,
hoverinfo = "text",
showlegend = FALSE,
text = ~paste('</br> Date: ', date,
'</br> Actual Log Copies: ', round(log_total_copies_both, digits = 2)),
marker = list(color = '#E7298A', size = 6, opacity = 0.65))
p_wrf_csave(p_wrf_c, file = "./plotly_objs/p_wrf_c.rda")save(wrfa_both, file = "./plotly_objs/wrfa_both.rda")
save(wrfb_both, file = "./plotly_objs/wrfb_both.rda")
save(wrfc_both, file = "./plotly_objs/wrfc_both.rda")save(date_vec_botha, file = "./plotly_objs/date_vec_botha.rda")
save(date_vec_bothb, file = "./plotly_objs/date_vec_bothb.rda")
save(date_vec_bothc, file = "./plotly_objs/date_vec_bothc.rda")save(both_ymina, file = "./plotly_objs/both_ymina.rda")
save(both_ymaxa, file = "./plotly_objs/both_ymaxa.rda")
save(both_yminb, file = "./plotly_objs/both_yminb.rda")
save(both_ymaxb, file = "./plotly_objs/both_ymaxb.rda")
save(both_yminc, file = "./plotly_objs/both_yminc.rda")
save(both_ymaxc, file = "./plotly_objs/both_ymaxc.rda")